home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib08.dsk / APPLE CAL.bas < prev    next >
BASIC Source File  |  2023-02-26  |  20KB  |  501 lines
  1. 1  REM  ***************************
  2. 2  REM  *      APPLE CAL          *
  3. 3  REM  *    BY GLENN TEMAN       *
  4. 4  REM  *   COPYRIGHT (C) 1982    *
  5. 5  REM  *   BY MICRO-SPARC INC    *
  6. 6  REM  *   LINCOLN, MA. 01773    *
  7. 7  REM  ***************************
  8. 10  DIM N$(12,31),MO$(12)
  9. 20 L$ =  CHR$(124):D$ =  CHR$(4)
  10. 30 DA$ = "312831303130313130313031":SLOT = 1
  11. 40  FOR I = 1 TO 12: READ A$:MO$(I) = A$: NEXT I
  12. 45  DATA  JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
  13. 60  DEF  FN M(X) = ((X/4 - INT(X/4)) *4): DEF  FN W(X) = ((X/7 - INT(X/7)) *7)
  14. 100  GOSUB 20000: REM  TITLE PAGE
  15. 110  HOME : VTAB 10: HTAB 11: PRINT "<JUST A MOMENT...>"
  16. 115  GOSUB 20400
  17. 120 YE = 1981:NOO = 1
  18. 130  ONERR  GOTO 11000
  19. 140 SAV = 0
  20. 150 Y = YE: GOSUB 7070:Y = 0
  21. 160  POKE 216,0
  22. 170 NOO = 0
  23. 500  REM  ** MENU **
  24. 510  HOME : PRINT : PRINT 
  25. 515  INVERSE 
  26. 520  PRINT "APPLE CAL";: HTAB 24: PRINT "BY GLENN TEMAN"
  27. 525  NORMAL 
  28. 530  VTAB 8
  29. 540  PRINT "1) PRINT CALENDAR"
  30. 550  VTAB 10: PRINT "2) ENTER/EDIT IMPORTANT DATES"
  31. 560  VTAB 12: PRINT "3) ENTER HOLIDAYS"
  32. 570  VTAB 14: PRINT "4) LIST IMPORTANT DATES"
  33. 580  VTAB 16: PRINT "5) QUIT"
  34. 590  VTAB 22: INVERSE : PRINT " CHOICE: ";: NORMAL 
  35. 600  INPUT " ";A$:I =  VAL(A$)
  36. 610  IF I <1  OR I >5  THEN  PRINT  CHR$(7): GOTO 510
  37. 620  ON I GOTO 1000,3000,4000,5000,10000
  38. 1000  REM  ** PRINT CALENDAR **
  39. 1010 A$ = "PRINT CALENDAR": GOSUB 8000
  40. 1020  VTAB 8: HTAB 1: PRINT "FROM MONTH (JAN): ";: CALL  -868
  41. 1030  VTAB 10: HTAB 1: PRINT "THRU MONTH (DEC): ";: CALL  -868
  42. 1040  VTAB 12: HTAB 1: PRINT "YEAR (";YE;"): ";: CALL  -868
  43. 1050  VTAB 14: HTAB 1: PRINT "     OK? (Y): ";: CALL  -868
  44. 1060  VTAB 8: HTAB 19: CALL  -868: INPUT "";A$
  45. 1070  IF A$ = "^"  THEN 500
  46. 1080  IF A$ = ""  THEN A$ = "JAN": VTAB 8: HTAB 19: PRINT "JAN"
  47. 1090  GOSUB 1280: IF ERR  THEN 1060
  48. 1100 F =  VAL(A$)
  49. 1110  VTAB 10: HTAB 19: CALL  -868: INPUT "";A$
  50. 1120  IF A$ = "^"  THEN 500
  51. 1130  IF A$ = ""  THEN A$ = "DEC": VTAB 10: HTAB 19: PRINT "DEC"
  52. 1140  GOSUB 1280: IF ERR  THEN 1110
  53. 1150 T =  VAL(A$)
  54. 1160  IF F >T  THEN  PRINT  CHR$(7);: GOTO 1060
  55. 1170  VTAB 12: HTAB 14: CALL  -868: INPUT "";Y$
  56. 1180  IF Y$ = "^"  THEN 500
  57. 1190  IF Y$ = ""  THEN Y$ =  STR$(YE): VTAB 12: HTAB 14: PRINT Y$
  58. 1200 Y =  VAL(Y$): IF Y <1981  OR Y >2000  THEN  PRINT  CHR$(7);: GOTO 1170
  59. 1210  VTAB 14: HTAB 15: CALL  -868: INPUT "";A$
  60. 1220  IF A$ < >""  AND  LEFT$(A$,1) < >"Y"  THEN 500
  61. 1230  VTAB 14: HTAB 15: PRINT "YES"
  62. 1233  REM  LOAD FROM DISK?
  63. 1235  IF YE < >Y  THEN YE = Y: GOSUB 7000
  64. 1240  GOSUB 1360: REM  FIND 1ST DAY OF MONTH
  65. 1250  GOTO 1500
  66. 1255  PRINT D$;"PR#0"
  67. 1260  GOTO 500
  68. 1270  REM 
  69. 1280  REM  ** MONTH ERROR **
  70. 1290 ERR = 0
  71. 1300  FOR I = 1 TO 12
  72. 1310  IF A$ =  MID$ ("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",I *3 -2,3)  THEN 1340
  73. 1320  NEXT I
  74. 1330  PRINT  CHR$(7);:ERR = 1: RETURN 
  75. 1340 A$ =  STR$(I): RETURN 
  76. 1350  REM 
  77. 1360  REM  ** LOOP ON MONTHS **
  78. 1370 KK = 5
  79. 1380 YR = Y -1981 -1: IF YR <0  THEN 1430
  80. 1390  FOR I = 0 TO YR
  81. 1400 KK = KK +365
  82. 1410 YY = 1981 +I: GOSUB 2600:KK = KK +LEAP
  83. 1420  NEXT 
  84. 1430 MN = F -1: IF MN <1  THEN 1480
  85. 1450  FOR I = 1 TO MN
  86. 1460 KK = KK + VAL( MID$ (DA$,I *2 -1,2))
  87. 1465  IF I = 2  THEN YY = Y: GOSUB 2600:KK = KK +LEAP: REM  FEB IN LEAP YR
  88. 1470  NEXT 
  89. 1480 DAY =  INT( FN W(KK) +.5): REM  WEEKDAY OF 1ST DAY OF MONTH
  90. 1485  IF DAY = 0  THEN DAY = 7
  91. 1490  RETURN 
  92. 1500 M = F -1
  93. 1505 M = M +1: IF M >T  THEN 1570
  94. 1510  GOSUB 1580
  95. 1515 KH = KK: GOSUB 2240: REM  LAST & NEXT MONTH
  96. 1520 KK = KH + VAL( MID$ (DA$,M *2 -1,2))
  97. 1530  IF M = 2  THEN YY = Y: GOSUB 2600:KK = KK +LEAP
  98. 1540 DAY =  INT( FN W(KK) +.5)
  99. 1545  IF DAY = 0  THEN DAY = 7
  100. 1550  PRINT : PRINT : PRINT : PRINT : PRINT : PRINT : REM  NEXT PAGE
  101. 1560  GOTO 1505
  102. 1570  GOTO 1255
  103. 1580  REM  ** PRINTING **
  104. 1590  PRINT : PRINT D$;"PR#";SLOT
  105. 1600  PRINT : PRINT : PRINT 
  106. 1610 M$ = MO$(M):L =  LEN(M$) *2:ND =  VAL( MID$ (DA$,M *2 -1,2))
  107. 1620  IF M = 2  THEN YY = Y: GOSUB 2600:ND = ND +LEAP
  108. 1630 S = (78 -L -3)/2
  109. 1640  PRINT  TAB( S); LEFT$("*********************",L +3)
  110. 1650  PRINT "   APPLE ]"; CHR$(91);"+";
  111. 1660  PRINT  TAB( S);"* ";
  112. 1670  FOR I = 1 TO L/2: PRINT  MID$ (M$,I,1);" ";: NEXT I: PRINT "*";
  113. 1680  PRINT  SPC( 67 -S -L);Y
  114. 1690  PRINT  TAB( S); LEFT$("*********************",L +3)
  115. 1700  PRINT : FOR I = 1 TO 78: PRINT "=";: NEXT 
  116. 1710  PRINT : PRINT L$;"    SUN   ";L$;"    MON   ";
  117. 1720  PRINT L$;"    TUE   ";L$;"    WED   ";L$;"    THR   ";L$;
  118. 1730  PRINT "    FRI   ";L$;"   SAT    ";L$
  119. 1740  FOR I = 1 TO 78: PRINT "=";: NEXT : PRINT 
  120. 1750 DAY =  -DAY +2
  121. 1760  FOR R = 1 TO 6
  122. 1770  FOR RR = 1 TO 6
  123. 1780  PRINT L$;: IF RR >1  THEN 1870
  124. 1790  FOR I = 1 TO 7
  125. 1800  IF DAY <1  OR DAY >ND  THEN  PRINT "  ";: GOTO 1830
  126. 1810  IF DAY <10  THEN  PRINT " ";
  127. 1820  PRINT DAY;
  128. 1830 DAY = DAY +1
  129. 1840  PRINT "        ";L$;
  130. 1850  NEXT I
  131. 1860  GOTO 2130
  132. 1870  IF RR >4  THEN 1920
  133. 1880  FOR I = 1 TO 7
  134. 1890  PRINT "          ";L$;
  135. 1900  NEXT I
  136. 1910  GOTO 2130
  137. 1920  FOR D = DAY -7 TO DAY -1
  138. 1930  IF D <1  OR D >ND  THEN SP = 10: GOTO 1960
  139. 1940 SP = 10
  140. 1950  IF N$(M,D) < >""  THEN  GOSUB 1990:SP = LFT
  141. 1960  PRINT  SPC( SP);L$;
  142. 1970  NEXT D
  143. 1980  GOTO 2130
  144. 1990  REM  ** NOTES ON CAL **
  145. 2000 A$ = N$(M,D)
  146. 2005 L = 0
  147. 2007 L = L +1: IF L > LEN(A$)  THEN 2030
  148. 2010  IF  MID$ (A$,L,1) = "/"  THEN 2110
  149. 2020  GOTO 2007
  150. 2030  IF  LEN(A$) <10  THEN LFT = 10: IF RR = 6  THEN  PRINT A$;:LFT = 10 - LEN(A$)
  151. 2035  IF  LEN(A$) <10  THEN  RETURN 
  152. 2040 L =  LEN(A$)/2:LFT = 10 -L
  153. 2050  IF L < > INT(L)  THEN 2080
  154. 2060  IF RR = 5  THEN  PRINT  LEFT$(A$,L);"-";:LFT = LFT -1: RETURN 
  155. 2070  PRINT  RIGHT$(A$,L);: RETURN 
  156. 2080  IF RR = 5  THEN  PRINT  LEFT$(A$,L);"-";: RETURN 
  157. 2090  PRINT  RIGHT$(A$,L +1);: RETURN 
  158. 2100  REM  2 LINES OF DATES (/)
  159. 2110  IF RR = 5  THEN  PRINT "."; LEFT$(A$,L -1);:LFT = 10 -L: RETURN 
  160. 2120  PRINT "."; RIGHT$(A$, LEN(A$) -L);:LFT = 9 - LEN(A$) +L: RETURN 
  161. 2130  PRINT 
  162. 2140  NEXT RR
  163. 2150  PRINT L$;
  164. 2160  FOR I = 1 TO 7
  165. 2170  PRINT "----------";
  166. 2180  IF I <7  THEN  PRINT "+";
  167. 2190  IF I = 7  THEN  PRINT L$
  168. 2200  NEXT I
  169. 2210  NEXT R
  170. 2220  RETURN 
  171. 2230  REM 
  172. 2240  REM  ** PRINT LAST & NEXT MONTH **
  173. 2250  IF M = 1  AND Y = 1981  THEN D1 =  -2 +2:N1 = 31:: GOTO 2290: REM  DEC '80
  174. 2260 F = M -1: IF F <1  THEN F = 12:Y = Y -1
  175. 2270  GOSUB 1360: IF F = 12  THEN Y = Y +1
  176. 2280 D1 =  -DAY +2:N1 =  VAL( MID$ (DA$,F *2 -1,2)): IF F = 2  THEN YY = Y: GOSUB 2600:N1 = N1 +LEAP
  177. 2290 F = M +1: IF F >12  THEN F = 1:Y = Y +1
  178. 2300  GOSUB 1360: IF F = 1  THEN Y = Y -1
  179. 2310 D2 =  -DAY +2:N2 =  VAL( MID$ (DA$,F *2 -1,2)): IF F = 2  THEN YY = Y: GOSUB 2600:N2 = N2 +LEAP
  180. 2320  FOR I = 1 TO 6
  181. 2330  IF I = 3  THEN  PRINT "   * NIBBLE MAGAZINE * ";: GOTO 2360
  182. 2340  IF I = 4  THEN  PRINT "   (C) GLENN TEMAN 1981";: GOTO 2360
  183. 2350  PRINT  SPC( 23);
  184. 2360  PRINT  SPC( 4);
  185. 2370  FOR J = 1 TO 7
  186. 2380  IF D1 <1  THEN  PRINT "   ";:D1 = D1 +1: GOTO 2430
  187. 2400  IF D1 >N1  THEN  PRINT "   ";: GOTO 2430
  188. 2410  IF D1 <10  THEN  PRINT " ";
  189. 2420  PRINT " ";D1;:D1 = D1 +1
  190. 2430  NEXT J
  191. 2440  PRINT  SPC( 5);
  192. 2450  FOR J = 1 TO 7
  193. 2460  IF D2 <1  THEN  PRINT "   ";:D2 = D2 +1: GOTO 2510
  194. 2480  IF D2 >N2  THEN  PRINT "   ";: GOTO 2510
  195. 2490  IF D2 <10  THEN  PRINT " ";
  196. 2500  PRINT " ";D2;:D2 = D2 +1
  197. 2510  NEXT J
  198. 2520  PRINT 
  199. 2530  NEXT I
  200. 2540  PRINT  SPC( 35);MO$(M -1 +12 *(M = 1));
  201. 2545 I =  LEN(MO$(M -1 +12 *(M = 1)))
  202. 2550  PRINT  SPC( 60 -35 -I);MO$(M +1 -12 *(M = 12))
  203. 2560  RETURN 
  204. 2600  REM  ** LEAP YR? **
  205. 2610 LEAP = 0
  206. 2620  IF  INT( FN M(YY) +.5) = 0  AND YY/100 < > INT(YY/100)  THEN LEAP = 1
  207. 2630  RETURN 
  208. 3000  REM  ** ENTER/EDIT IMPORTANT DATES **
  209. 3010 A$ = "ENTER/EDIT IMPORTANT DATES": GOSUB 8000:L = 0
  210. 3020  VTAB 8: HTAB 1: CALL  -868: PRINT "YEAR (";YE;"):"
  211. 3030  VTAB 12: HTAB 1: CALL  -868: PRINT "MONTH:"
  212. 3040  VTAB 14: HTAB 1: CALL  -868: PRINT "DAY:"
  213. 3050  VTAB 16: HTAB 1: CALL  -868: PRINT "TEXT:"
  214. 3060  IF L  THEN 3110
  215. 3070  VTAB 8: HTAB 14: CALL  -868: INPUT "";Y$
  216. 3080  IF Y$ = ""  THEN Y$ =  STR$(YE): VTAB 8: HTAB 14: PRINT Y$;
  217. 3090  IF Y$ = "^"  THEN 500
  218. 3100 Y =  VAL(Y$): IF Y <1981  OR Y >2000  THEN  PRINT  CHR$(7);: GOTO 3070
  219. 3105  IF Y < >YE  THEN  GOSUB 7000:YE = Y
  220. 3110  VTAB 12: HTAB 8: CALL  -868: INPUT "";A$
  221. 3120  IF A$ = "^"  THEN 3400
  222. 3130  GOSUB 1280: IF ERR  THEN 3110
  223. 3140 M =  VAL(A$)
  224. 3150  VTAB 14: HTAB 6: CALL  -868: INPUT "";A$
  225. 3160  IF A$ = "^"  THEN 500
  226. 3170 DAY =  VAL(A$): IF DAY = 0  THEN  PRINT  CHR$(7);: GOTO 3150
  227. 3180 D =  VAL( MID$ (DA$,M *2 -1,2)): IF DAY >D  AND M < >2  THEN  PRINT  CHR$(7);: GOTO 3150
  228. 3190  IF M = 2  THEN YY = Y: GOSUB 2600: IF DAY >D +LEAP  THEN  PRINT  CHR$(7);: GOTO 3150
  229. 3200 Y$ = "": IF N$(M,DAY) < >""  THEN Y$ = N$(M,DAY): VTAB 17: HTAB 7: CALL  -868: PRINT "(";Y$;")";
  230. 3210  VTAB 16: HTAB 7: CALL  -868: PRINT "..................";: HTAB 7: INPUT "";A$
  231. 3220  IF A$ = ""  AND Y$ < >""  THEN  CALL  -868: VTAB 16: HTAB 7: PRINT Y$: GOTO 3300
  232. 3225  IF A$ = "*"  THEN  CALL  -868: PRINT "<DELETED>";:N$(M,DAY) = "": GOTO 3300
  233. 3230  IF A$ = "^"  THEN 3400
  234. 3240  IF A$ = ""  THEN 3300
  235. 3250  IF  LEN(A$) >18  THEN  PRINT  CHR$(7);: GOTO 3200
  236. 3260  FOR I = 1 TO  LEN(A$): IF  MID$ (A$,I,1) = "/"  THEN 3280
  237. 3270  NEXT : GOTO 3290
  238. 3280  IF I >10  OR  LEN(A$) -I >9  THEN  PRINT  CHR$(7);: GOTO 3200
  239. 3290 N$(M,DAY) = A$
  240. 3300  FOR I = 1 TO 750: NEXT I
  241. 3310 L = 1
  242. 3320  VTAB 11: CALL  -958: GOTO 3030
  243. 3400  VTAB 20: CALL  -958: INPUT "SAVE FILE TO DISK? ";A$
  244. 3410  IF  LEFT$(A$,1) = "Y"  THEN  GOSUB 6000
  245. 3420  GOTO 500
  246. 4000  REM  ** ENTER HOLIDAYS **
  247. 4010 A$ = "ENTER HOLIDAYS": GOSUB 8000
  248. 4020  VTAB 8: HTAB 1: PRINT "YEAR (";YE;"):"
  249. 4030  VTAB 12: HTAB 1: PRINT "HOLIDAY:"
  250. 4040  VTAB 14: HTAB 5: PRINT "MONTH:";: HTAB 28: PRINT "DAY:"
  251. 4060  VTAB 8: HTAB 14: CALL  -868: INPUT "";Y$
  252. 4070  IF Y$ = ""  THEN Y$ =  STR$(YE): VTAB 8: HTAB 14: PRINT Y$;
  253. 4080  IF Y$ = "^"  THEN 500
  254. 4090 Y =  VAL(Y$): IF Y <1981  OR Y >2000  THEN  PRINT  CHR$(7);: GOTO 4060
  255. 4092  IF Y < >YE  THEN  GOSUB 7000:YE = Y
  256. 4095 R = 0: IF Y <1987  THEN R = (6 +Y -1986) *17
  257. 4100  RESTORE : FOR I = 1 TO 12 +R: READ A$: NEXT 
  258. 4120  FOR I = 1 TO 17
  259. 4130  READ A$: IF  VAL(A$) >0  THEN 4300
  260. 4140 M =  VAL( RIGHT$(A$,2)):A$ =  LEFT$(A$, LEN(A$) -2)
  261. 4150  VTAB 12: HTAB 10: PRINT A$;
  262. 4160  VTAB 14: HTAB 13: PRINT MO$(M);
  263. 4170  VTAB 14: HTAB 34: CALL  -868: INPUT "";Y$
  264. 4180  IF Y$ = "^"  THEN 4440: REM  SAVE?
  265. 4190  IF Y$ = "*"  THEN 4410: REM  NEXT
  266. 4200 DAY =  VAL(Y$): IF D<CTRL-A>AY = 0  THEN  PRINT  CHR$(7);: GOTO 4170
  267. 4210 D =  VAL( MID$ (DA$,M *2 -1,2)): IF DAY >D  AND M < >2  THEN  PRINT  CHR$(7);: GOTO 4170
  268. 4220  IF M = 2  THEN YY = Y: GOSUB 2600: IF DAY >D +LEAP  THEN  PRINT  CHR$(7);: GOTO 4170
  269. 4230  IF N$(M,DAY) = ""  THEN 4400: REM  FILE
  270. 4240  VTAB 20: HTAB 1: CALL  -868: PRINT "REPLACE ";N$(M,DAY)
  271. 4250  PRINT "   WITH ";A$;: INPUT "     OK? ";B$
  272. 4260  IF  LEFT$(B$,1) = "Y"  THEN 4400: REM  FILE
  273. 4270  VTAB 21: CALL  -868: PRINT "    <NOT REPLACED>";
  274. 4280  GOTO 4410: REM  NEXT
  275. 4300 M =  VAL( RIGHT$(A$,2)):DAY =  VAL( LEFT$(A$,2)):A$ =  MID$ (A$,3, LEN(A$) -4)
  276. 4310  VTAB 12: HTAB 10: PRINT A$;
  277. 4320  VTAB 14: HTAB 13: PRINT MO$(M);
  278. 4330  HTAB 34: PRINT DAY
  279. 4340  IF N$(M,DAY) = ""  OR A$ = N$(M,DAY)  THEN 4370
  280. 4350  VTAB 20: HTAB 1: CALL  -868: PRINT "REPLACE ";N$(M,DAY)
  281. 4360  PRINT "    WITH ";A$;
  282. 4370  INPUT "    OK? (Y) ";B$
  283. 4375  IF B$ = "^"  THEN 4440
  284. 4380  IF  LEFT$(B$,1) = "Y"  OR B$ = ""  THEN 4400: REM  FILE
  285. 4390  VTAB 21: CALL  -868: PRINT "    <NOT FILED>";: FOR J = 1 TO 500: NEXT J: GOTO 4410: REM  NEXT
  286. 4400 N$(M,DAY) = A$
  287. 4410  VTAB 10: CALL  -958: VTAB 12: HTAB 1: PRINT "HOLIDAY:"
  288. 4420  VTAB 14: HTAB 5: PRINT "MONTH:";: HTAB 28: PRINT "DAY:"
  289. 4430  NEXT I
  290. 4440  VTAB 20: CALL  -958: INPUT "SAVE FILE TO DISK? ";A$
  291. 4450  IF  LEFT$(A$,1) = "Y"  THEN  GOSUB 6000
  292. 4460  GOTO 500
  293. 4500  REM  >1986
  294. 4510  DATA  01NEW YEAR'S DAY01,14VALENTINE'S DAY02,WASHINGTON'S BDAY02,17ST PATRICK'S DAY03,PASSOVER04,EASTER04,MOTHER'S DAY05,MEMORIAL DAY05,FATHER'S DAY06
  295. 4520  DATA  04INDEPENDENCE DAY07,LABOR DAY09,COLUMBUS DAY10,31HALLOWEEN10,11VETERAN'S DAY11,THANKSGIVING11,HANUKKAH12,25CHRISTMAS12
  296. 4530  REM  1981
  297. 4540  DATA  01NEW YEAR'S DAY01,14VALENTINE'S DAY02,16WASHINGTON'S BDAY02,17ST PATRICK'S DAY03,19PASSOVER04,19EASTER04,10MOTHER'S DAY05,25MEMORIAL DAY05,21FATHER'S DAY06
  298. 4550  DATA  04INDEPENDENCE DAY07,07LABOR DAY09,12COLUMBUS DAY10,31HALLOWEEN10,11VETERAN'S DAY11,26THANKSGIVING11,21HANUKKAH12,25CHRISTMAS12
  299. 4560  REM  1982
  300. 4570  DATA  01NEW YEAR'S DAY01,14VALENTINE'S DAY02,15WASHINGTON'S BDAY02,17ST PATRICK'S DAY03,08PASSOVER04,11EASTER04,09MOTHER'S DAY05,31MEMORIAL DAY05,20FATHER'S DAY06
  301. 4580  DATA  04INDEPENDENCE DAY07,06LABOR DAY09,11COLUMBUS DAY10,31HALLOWEEN10,11VETERAN'S DAY11,25THANKSGIVING11,11HANUKKAH12,25CHRISTMAS12
  302. 4590  REM  1983
  303. 4600  DATA  01NEW YEAR'S DAY01,14VALENTINE'S DAY02,21WASHINGTON'S BDAY02,17ST PATRICK'S DAY03,29PASSOVER03,03EASTER04,08MOTHER'S DAY05,30MEMORIAL DAY05,19FATHER'S DAY06
  304. 4610  DATA  04INDEPENDENCE DAY07,05LABOR DAY09,10COLUMBUS DAY10,31HALLOWEEN10,11VETERAN'S DAY11,24THANKSGIVING11,01HANUKKAH12,25CHRISTMAS12
  305. 4620  REM  1984
  306. 4630  DATA  01NEW YEAR'S DAY01,14VALENTINE'S DAY02,20WASHINGTON'S BDAY02,17ST PATRICK'S DAY03,17PASSOVER04,22EASTER04,13MOTHER'S DAY05,28MEMORIAL DAY05,17FATHER'S DAY06
  307. 4640  DATA  04INDEPENDENCE DAY07,03LABOR DAY09,08COLUMBUS DAY10,31HALLOWEEN10,11VETERAN'S DAY11,22THANKSGIVING11,19HANUKKAH12,25CHRISTMAS12
  308. 4650  REM  1985
  309. 4660  DATA  01NEW YEAR'S DAY01,14VALENTINE'S DAY02,18WASHINGTON'S BDAY02,17ST PATRICK'S DAY03,06PASSOVER04,07EASTER04,12MOTHER'S DAY05,27MEMORIAL DAY05,16FATHER'S DAY06
  310. 4670  DATA  04INDEPENDENCE DAY07,02LABOR DAY09,14COLUMBUS DAY10,31HALLOWEEN10,11VETERAN'S DAY11,28THANKSGIVING11,08HANUKKAH12,25CHRISTMAS12
  311. 4680  REM  1986
  312. 4690  DATA  01NEW YEAR'S DAY01,14VALENTINE'S DAY02,17WASHINGTON'S BDAY02,17ST PATRICK'S DAY03,24PASSOVER04,30EASTER03,11MOTHER'S DAY05,26MEMORIAL DAY05,15FATHER'S DAY06
  313. 4700  DATA  04INDEPENDENCE DAY07,01LABOR DAY09,13COLUMBUS DAY10,31HALLOWEEN10,11VETERAN'S DAY11,27THANKSGIVING11,27HANUKKAH12,25CHRISTMAS12
  314. 5000  REM  ** LIST DATES **
  315. 5010 A$ = "LIST DATES": GOSUB 8000
  316. 5020  VTAB 8: HTAB 1: PRINT "YEAR (";YE;"):"
  317. 5030  VTAB 10: HTAB 1: PRINT "FROM MONTH (JAN):"
  318. 5040  VTAB 12: HTAB 1: PRINT "TO MONTH (DEC):"
  319. 5050  VTAB 14: HTAB 1: PRINT "PRINTER OR SCREEN:"
  320. 5060  VTAB 8: HTAB 14: CALL  -868: INPUT "";Y$
  321. 5070  IF Y$ = "^"  THEN 500
  322. 5080  IF Y$ = ""  THEN Y$ =  STR$(YE): VTAB 8: HTAB 14: PRINT Y$
  323. 5090 Y =  VAL(Y$): IF Y <1981  OR Y >2000  THEN  PRINT  CHR$(7);: GOTO 5060
  324. 5100  IF Y < >YE  THEN  GOSUB 7000:YE = Y: REM  LOAD
  325. 5110  VTAB 10: HTAB 19: CALL  -868: INPUT "";A$
  326. 5120  IF A$ = "^"  THEN 500
  327. 5130  IF A$ = ""  THEN A$ = "JAN": VTAB 10: HTAB 19: PRINT A$
  328. 5140  GOSUB 1280: IF ERR  THEN 5110
  329. 5150 F =  VAL(A$)
  330. 5160  VTAB 12: HTAB 17: CALL  -868: INPUT "";A$
  331. 5170  IF A$ = "^"  THEN 500
  332. 5180  IF A$ = ""  THEN A$ = "DEC": VTAB 12: HTAB 17: PRINT A$
  333. 5190  GOSUB 1280: IF ERR  THEN 5160
  334. 5200 T =  VAL(A$)
  335. 5210  VTAB 14: HTAB 20: CALL  -868: INPUT "";A$
  336. 5220  IF A$ = "^"  THEN 500
  337. 5230  IF  LEFT$(A$,1) = "S"  THEN 5260
  338. 5240  IF  LEFT$(A$,1) < >"P"  THEN  PRINT  CHR$(7);: GOTO 5210
  339. 5250  PRINT D$;"PR#";SLOT
  340. 5255  PRINT : PRINT : PRINT 
  341. 5260  HOME 
  342. 5270 A$ = "DATES LIST: " + STR$(Y)
  343. 5280  PRINT  TAB( 12);A$
  344. 5290 A$ = MO$(F) +" THRU " +MO$(T)
  345. 5300  PRINT  TAB( (40 - LEN(A$))/2);A$
  346. 5310  PRINT : PRINT 
  347. 5320  FOR M = F TO T
  348. 5330  PRINT : PRINT MO$(M)
  349. 5340  FOR D = 1 TO 31
  350. 5350  IF N$(M,D) = ""  THEN 5370
  351. 5360  PRINT  TAB( 3);D; TAB( 7);N$(M,D)
  352. 5370  NEXT D
  353. 5380  NEXT M
  354. 5385  PRINT  CHR$(12)
  355. 5390  PRINT D$;"PR#0"
  356. 5400  PRINT : INPUT "    <HIT 'RETURN' TO CONTINUE...";A$
  357. 5410  GOTO 500
  358. 6000  REM  ** SAVE TO DISK **
  359. 6010  ONERR  GOTO 11000
  360. 6015 SAV = 1
  361. 6020  PRINT " (";YE;: INPUT ") ARE YOU SURE? ";B$
  362. 6030  IF  LEFT$(B$,1) = "N"  THEN 6160
  363. 6040  IF  LEFT$(B$,1) < >"Y"  THEN  PRINT  CHR$(7);: GOTO 6020
  364. 6050 B$ = "CAL.FILE-" + STR$(YE)
  365. 6060  PRINT D$;"UNLOCK";B$
  366. 6070  PRINT D$;"OPEN";B$
  367. 6080  PRINT D$;"WRITE";B$
  368. 6090  FOR M = 1 TO 12
  369. 6100  FOR D = 1 TO 31
  370. 6110  PRINT N$(M,D)
  371. 6120  NEXT D
  372. 6130  NEXT M
  373. 6140  PRINT D$;"CLOSE";B$
  374. 6150  PRINT D$;"LOCK";B$
  375. 6160  POKE 216,0: REM  OFF ONERR
  376. 6170  PRINT  CHR$(7);
  377. 6180  RETURN 
  378. 7000  REM  **LOAD FROM DISK**
  379. 7010 SAV = 0
  380. 7020  VTAB 20: PRINT Y;" FILE NOT IN MEMORY."
  381. 7030  INPUT "LOAD FROM DISK? ";B$
  382. 7040  IF  LEFT$(B$,1) = "N"  THEN 7200
  383. 7050  IF  LEFT$(B$,1) < >"Y"  THEN  PRINT  CHR$(7);: GOTO 7030
  384. 7060  ONERR  GOTO 11000
  385. 7070 B$ = "CAL.FILE-" + STR$(Y)
  386. 7080  PRINT D$;"OPEN";B$
  387. 7090  PRINT D$;"READ";B$
  388. 7100  FOR M = 1 TO 12
  389. 7110  FOR D = 1 TO 31
  390. 7120  INPUT N$(M,D)
  391. 7130  NEXT D
  392. 7140  NEXT M
  393. 7150  PRINT D$;"CLOSE";B$
  394. 7160  PRINT  CHR$(7);: POKE 216,0: REM  OFF ONERR
  395. 7170  RETURN 
  396. 7200  PRINT "  <CLEARING OLD DATE FILE>"
  397. 7210  FOR M = 1 TO 12
  398. 7220  FOR D = 1 TO 31
  399. 7230 N$(M,D) = ""
  400. 7240  NEXT D
  401. 7250  NEXT M
  402. 7260  PRINT  CHR$(7);
  403. 7270  RETURN 
  404. 8000  HOME : PRINT 
  405. 8010 A$ = " " +A$ +" ": HTAB (40 - LEN(A$))/2
  406. 8020  INVERSE : PRINT A$: NORMAL 
  407. 8030  PRINT 
  408. 8040  RETURN 
  409. 10000  REM  ** QUIT **
  410. 10005 A$ = "QUIT": GOSUB 8000
  411. 10010  VTAB 5: CALL  -868: INPUT "ARE YOU SURE? ";A$
  412. 10020  IF  LEFT$(A$,1) = "N"  THEN 500
  413. 10030  IF  LEFT$(A$,1) < >"Y"  THEN  PRINT  CHR$(7);: GOTO 10010
  414. 10040  VTAB 10: PRINT "APPLE CAL"; TAB( 23);"BY GLENN TEMAN"
  415. 10050  VTAB 20: HTAB 10: PRINT "<G O O D   B Y E !!>"
  416. 10060  PRINT : END 
  417. 11000  REM  **ONERR**
  418. 11010 ERR =  PEEK(222)
  419. 11020 L =  PEEK(218) + PEEK(219) *256: CALL 768: REM  FIX STACK
  420. 11030  ON (ERR) GOTO 11040,11040,11040,11080,11130,11190,11040,11220,11260
  421. 11040  REM  -UNIDENT ERROR
  422. 11050  PRINT : PRINT "ERROR: "; CHR$(7);ERR
  423. 11060  PRINT " ON LINE ";L; CHR$(7)
  424. 11070  PRINT : END 
  425. 11080  REM  -WRT PROTECTED
  426. 11090  PRINT "<WRITE PROTECTED - INSERT NEW DISK..."
  427. 11100  INPUT "  <AND HIT 'RETURN': ";A$
  428. 11120  GOSUB 6070: GOTO 500
  429. 11130  REM  -END OF DATA
  430. 11135  REM  ('LOAD FROM DISK' ERROR)
  431. 11140  IF SAV = 1  THEN 11040
  432. 11150  PRINT D$;"DELETE";B$
  433. 11160  VTAB 20: CALL  -868
  434. 11165  IF NOO  THEN 160
  435. 11170  PRINT "<FILE NOT FOUND!>"
  436. 11180  POKE 216,0: GOSUB 7200: GOTO 500
  437. 11190  REM  -FILE NOT FOUND
  438. 11195  REM  ('SAVE TO DISK' ERROR)
  439. 11200  IF SAV = 0  THEN 11040
  440. 11210  GOSUB 6070: REM  SKIP 'UNLOCK'
  441. 11215  GOTO 500
  442. 11220  REM  -I/O ERROR
  443. 11230  PRINT "<I/O ERROR - INSERT NEW DISK..."
  444. 11240  INPUT "  <AND HIT 'RETURN': ";A$
  445. 11245  IF SAV = 1  THEN  GOSUB 6060: GOTO 500
  446. 11250  IF SAV = 0  THEN  GOSUB 7080: GOTO 500
  447. 11260  REM  -DISK FULL
  448. 11270  PRINT D$;"DELETE";B$
  449. 11280  PRINT "<DISK FULL - INSERT NEW DISK..."
  450. 11290  INPUT "  <AND HIT 'RETURN': ";A$
  451. 11300  GOSUB 6070: GOTO 500
  452. 20000  REM  ** TITLE PAGE **
  453. 20005  TEXT : HOME :L = 25
  454. 20007  PRINT  CHR$(7);
  455. 20010  VTAB 8: HTAB 9: PRINT "*********************"
  456. 20020  VTAB 12: HTAB 9: PRINT "*********************"
  457. 20030  VTAB 9: FOR I = 1 TO 3
  458. 20040  HTAB 9: PRINT "*";: HTAB 29: PRINT "*"
  459. 20050  NEXT I
  460. 20055  FLASH 
  461. 20060  VTAB 10: HTAB 11: PRINT "A P P L E   C A L"
  462. 20065  NORMAL 
  463. 20070  VTAB 18: HTAB 23: PRINT "BY GLENN TEMAN"
  464. 20080  POKE  -16368,0
  465. 20090  VTAB 23: PRINT "    <HIT ANY KEY TO CONTINUE...>"
  466. 20100  FOR I = 1 TO 2  STEP 0
  467. 20110  VTAB 8: FOR J = 9 TO 28
  468. 20120  HTAB J: PRINT " ";
  469. 20130  FOR D = 1 TO L: NEXT D
  470. 20140  HTAB J: PRINT "*";
  471. 20150  NEXT J
  472. 20160  IF  PEEK( -16384) >127  THEN 20350
  473. 20170  FOR J = 8 TO 11
  474. 20180  VTAB J: HTAB 29: PRINT " ";
  475. 20190  FOR D = 1 TO L: NEXT D
  476. 20195  HTAB 29: PRINT "*";
  477. 20200  NEXT J
  478. 20210  IF  PEEK( -16384) >127  THEN 20350
  479. 20220  VTAB 12: FOR J = 29 TO 10  STEP  -1
  480. 20230  HTAB J: PRINT " ";
  481. 20240  FOR D = 1 TO L: NEXT D
  482. 20250  HTAB J: PRINT "*";
  483. 20260  NEXT J
  484. 20270  IF  PEEK( -16384) >127  THEN 20350
  485. 20280  FOR J = 12 TO 9  STEP  -1
  486. 20290  HTAB 9: VTAB J: PRINT " ";
  487. 20300  FOR D = 1 TO L: NEXT D
  488. 20310  HTAB 9: PRINT "*";
  489. 20320  NEXT J
  490. 20330  IF  PEEK( -16384) >127  THEN 20350
  491. 20340  NEXT I
  492. 20350  POKE  -16368,0
  493. 20360  PRINT  CHR$(7)
  494. 20370  RETURN 
  495. 20400  REM  ** FIX STACK ONERR **
  496. 20405  REM  FROM PG 136, APPLE REF MANUAL
  497. 20410 A$ = "104168104166223154072152072096"
  498. 20420  FOR I = 1 TO 10
  499. 20430  POKE 767 +I, VAL( MID$ (A$,I *3 -2,3))
  500. 20440  NEXT 
  501. 20450  RETURN